home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap07 / howto06 / delphi10 / soundex / soundex.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-09-17  |  1.4 KB  |  65 lines
  1. unit Soundex;
  2.  
  3. interface
  4.  
  5. type
  6.   SoundexString = String[4];
  7.  
  8. function SoundexCode( TargetString: String ) : SoundexString;
  9.  
  10. implementation
  11.  
  12. uses SysUtils;
  13.  
  14. type
  15.   LetterMap = array [1..26] of char;
  16.  
  17. const
  18.  
  19.   Code : LetterMap = (
  20.     '0', '1', '2', '3', '0', '1', '2', '0', '0',
  21.     '2', '2', '4', '5', '5', '0', '1', '2', '6',
  22.     '2', '3', '0', '1', '0', '2', '0', '2'
  23.   );
  24.  
  25. function SoundexCode( TargetString: String ) : SoundexString;
  26. var
  27.   ResultIndex: Integer;
  28.   TargetIndex: Integer;
  29.   TargetLength: Integer;
  30.  
  31. begin
  32.   TargetString := UpperCase( TargetString );
  33.   Result := '0000';
  34.   Result[1] := TargetString[1];
  35.  
  36.   TargetLength := Length( TargetString );
  37.  
  38.   if TargetLength = 1 then exit;
  39.  
  40.   for TargetIndex := 2 to TargetLength do
  41.     if TargetString[ TargetIndex ] in [ 'A'..'Z' ] then
  42.       { Map ordinary letters into Soundex code }
  43.       TargetString[ TargetIndex ] :=
  44.         Code[ Ord( TargetString[ TargetIndex ]) - Ord( 'A' ) + 1]
  45.     else
  46.       { Ignore any other character }
  47.       TargetString[TargetIndex] := '0';
  48.  
  49.   ResultIndex := 2;
  50.   for TargetIndex := 2 to TargetLength do
  51.   begin
  52.     if ( TargetString[ TargetIndex ] <> '0' ) and
  53.        ( TargetString[ TargetIndex ] <>
  54.          TargetString[ TargetIndex - 1 ] ) then
  55.     begin
  56.       Result[ ResultIndex ] := TargetString[ TargetIndex ];
  57.       inc( ResultIndex );
  58.       if ResultIndex > 4 then exit
  59.     end;
  60.   end;
  61.  
  62. end;
  63.  
  64. end.
  65.